#lang racket


(require "../proxies/main.rkt")

(provide (struct-out shape)
         (struct-out empty-shape)
         (struct-out universal-shape)
         
         (struct-out simple-shape)
         make-simple-shape
         
         (struct-out list-shape)
         make-list-shape
         
         shape-id
         map-shape-id
         for-each-shape-id)


(struct shape
  ((backend #:auto #:mutable)
   (node #:auto #:mutable))
  #:auto-value #f)

(struct empty-shape shape ())
(struct universal-shape shape ())


(struct simple-shape shape (id))

(define (make-simple-shape id (backend #f) (node #f))
  (unless (id? id)
    (error 'make-simple-shape))
  (let ((shape
         (cond ((empty-id? id) (empty-shape))
               ((universal-id? id) (universal-shape))
               (else (simple-shape id)))))
    (set-shape-backend! shape backend)
    (set-shape-node! shape node)
    shape))


(struct list-shape shape (shapes))

(define (make-list-shape shapes (backend #f) (node #f))
  (unless (andmap shape? shapes)
    (error 'make-list-shape))
  (let ((shape (list-shape shapes)))
    (set-shape-backend! shape backend)
    (set-shape-node! shape node)
    shape))


(define (shape-id shape)
  (match shape
    ((empty-shape _ _) (empty-id))
    ((universal-shape _ _) (universal-id))
    ((simple-shape _ _ id) id)
    ((list-shape _ _ shapes) (map shape-id shapes))))

(define (map-shape-id fn shape)
  (match shape
    ((empty-shape _ _) shape)
    ((universal-shape _ _) shape)
    ((simple-shape backend node id) (make-simple-shape (fn id) backend node))
    ((list-shape backend node shapes) (make-list-shape (map (λ (shape) (map-shape-id fn shape)) shapes) backend node))))

(define (for-each-shape-id fn! shape)
  (match shape
    ((empty-shape _ _) (void))
    ((universal-shape _ _) (void))
    ((simple-shape _ _ id) (fn! id))
    ((list-shape _ _ shapes) 
     (for-each (lambda (shape)
                 (for-each-shape-id fn! shape))
               shapes))))